{***************************************************************
    SpyGestion  Copyright (C) 2008 Christophe KOALI <nature2gas@gmail.com>
    
    This program is free software: you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation, either version 3 of the License, or
    (at your option) any later version.
    
    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.
    
    You should have received a copy of the GNU General Public License
    along with this program.  If not, see <http://www.gnu.org/licenses/>.
    
****************************************************************}
unit modLanguageParsing;

interface

uses Classes, sFonctionsChaines, SysUtils;

type
    TLangValueKey = record
       Key: string;
       Valeur: string;
    end;

    PLangValueKey = ^TLangValueKey;

type
     TParsingLanguage = class(TList)
     private
         FFichier: string;

         FLangComboName: string;
         FGidToStrFile: string;

         FLoginURL: string;
         FLoginReference: string;

         FLoginSpecial : boolean;

        {$IFDEF DEBUGLANG}
           // information de débogage
           FDebugProc: TsfcProcStatus;
        {$ENDIF}

        
         procedure LoadSectionGeneral(Key, Value: string);
         procedure LoadSectionLogin(Key, Value: string);
         procedure LoadSectionStrings(Key, Value: string);

         
         {$IFDEF DEBUGLANG}
             procedure DoDebug(const Msg: string);
         {$ENDIF}
     public
         property NomCombo : string read FLangComboName;
         property GidToStrFile : string read FGidToStrFile;

         property LoginURL : string read FLoginURL;
         property LoginReference : string read FLoginReference;
         property LoginSpecial: boolean read FLoginSpecial;


         function  IsValidHeader: boolean;
         procedure Cleanup;

         function GetData(Id: string; Default: string): string;
         function GetDataChar(Id: string; Default: char): char;

         function ExistKey(const Key: string): boolean;
         function GetValeur(const Element: string): PLangValueKey;


         function LoadFromFile(Fichier: string; bLoadHeaderOnly: boolean): integer;
         function SaveToFile(Fichier: string): integer;

         constructor Create;
         destructor Destroy; override;
         procedure Clear; override;

         function Delete(Index: integer): boolean;
         function Add(Key, Valeur: string): PLangValueKey;
         procedure SimpleAdd(Pointeur: PLangValueKey);
     end;

var
    LangParsing: TParsingLanguage;

implementation

const
    CNT_SECTION_GENERAL      = 'general';
    CNT_GENERAL_NAME_COMBO   = 'name';
    CNT_GENERAL_GIDTOSTRFILE = 'gidtostr';

    CNT_SECTION_LOGIN   = 'login';
    CNT_LOGIN_URL       = 'url';
    CNT_LOGIN_REFERENCE = 'reference';
    CNT_LOGIN_SPECIAL   = 'special';


    CNT_SECTION_STRINGS = 'strings';

{$IFDEF DEBUGLANG}
   procedure TParsingLanguage.DoDebug(const Msg: string);
   begin
       if Assigned(FDebugProc) then
          FDebugProc(Msg);

   end;
{$ENDIF}

// Simple ajout de pointeur
procedure TParsingLanguage.SimpleAdd(Pointeur: PLangValueKey);
begin
    inherited Add(Pointeur);  // Ajoute le pointeur à la liste
end;

function TParsingLanguage.Add(Key, Valeur: string): PLangValueKey;
begin

    New(Result);          // Créer l'espace mémoire requis
    Result.Key := Key;
    Result.Valeur := Valeur;


    try
       inherited Add(Result);  // Ajoute le pointeur à la liste
    except
       Result := nil;
    end;
    
    // Pour libérer la mémoire occupé par l'élément pointer:  Dispose(pElement);

end;



function TParsingLanguage.Delete(Index: integer): boolean;
var pElement: PLangValueKey;
begin

    Result := false;

    if (Index < 0) or (Index >= Count) then
       // Hors limite
       exit;


    // Obtient le pointeur
    pElement := Items[Index];

    if pElement <> nil then
       // Libére la mémoire créée lors de l'ajout
       Dispose(pElement);

    // Supprime le pointeur de la liste
    inherited Delete(Index);

    // Met le resultat à True
    Result := true;

end;

constructor TParsingLanguage.Create;
begin
    
    // Héritage
    InHerited Create;
    
    
    
    // Code pour l'initialisation ici
    Cleanup;

    {$IFDEF DEBUGLANG}
        // information de débogage
        FDebugProc := nil;
    {$ENDIF}

end;

destructor TParsingLanguage.Destroy;
begin
    // Implémenter le code avant l'héritage de la méthode
    // C'est à dire ici
    
   
    // On appelle NOTRE clear qui lui-même appelle NOTRE Delete qui libère l'espace mémoire
    // avant d'enlever le pointeur de la TList
    // L'héritage de Destroy appelle Clear, mais es-ce le notre ou celui de la classe de base ?
    Clear;
    
    
    // Héritage
    InHerited Destroy;
end;

function TParsingLanguage.ExistKey(const Key: string): boolean;
begin
    Result := GetValeur(Key) <> nil;
end;

function TParsingLanguage.GetValeur(const Element: string): PLangValueKey;
var i: integer;
begin

   if Count = 0 then begin
      Result := nil;
      exit;
   end;

   for i := 0 to Count - 1 do begin

      Result := Items[i];

      if SameText(Result.Key, Element) then begin
         exit;
      end;
   end;

   Result := nil;
end;



procedure TParsingLanguage.Clear;
var i: integer;
begin

    if Count > 0 then begin
        For i := Count -1 downto 0 do
            Delete(i);
    end;

    inherited Clear;
end;


function TParsingLanguage.IsValidHeader: boolean;
begin
    Result := false;
    if length(FLangComboName) < 4 then exit;

    if lowercase(copy(FLoginURL, 1, 4)) <> 'http' then exit;
    if lowercase(copy(FLoginReference, 1, 4)) <> 'http' then begin
       if NoT(FLoginSpecial) then begin
          exit;
       end;
    end;

    Result := true;
end;

procedure TParsingLanguage.Cleanup;
begin
      FFichier   := '';

      FLangComboName  := '';

      FLoginURL  := '';
      FLoginReference  := '';

      FLoginSpecial := false;

      Clear;
end;

procedure TParsingLanguage.LoadSectionGeneral(Key, Value: string);
begin
     if SameText(Key, CNT_GENERAL_NAME_COMBO) then begin
         FLangComboName := trim(Value);
     end else if SameText(Key, CNT_GENERAL_GIDTOSTRFILE) then begin
         FGidToStrFile := trim(Value);
     end;

end;

procedure TParsingLanguage.LoadSectionLogin(Key, Value: string);
begin
     if SameText(Key, CNT_LOGIN_URL) then begin
         FLoginURL := trim(Value);
     end else if SameText(Key, CNT_LOGIN_REFERENCE) then begin
         FLoginReference := trim(Value);

     end else if SameText(Key, CNT_LOGIN_SPECIAL) then begin
         FLoginSpecial := Value = '1';
     end;

end;

procedure TParsingLanguage.LoadSectionStrings(Key, Value: string);
begin
    Add(Key, Value);
end;


function TParsingLanguage.SaveToFile(Fichier: string): integer;
var i: integer;
    F: TextFile;
    pElement: PLangValueKey;
begin

    Result := -2;

    if Fichier = '' then Fichier := FFichier;

    AssignFile(F, Fichier);
    
    {$I-}
    ReWrite(F);
    {$I+}
    
    // IOResult renvoie 0 => cela signifie que la dernière opération d'E/S a réussi
    if NoT(IOResult = 0) then begin
       Result := -1;
       exit;
    end;

    WriteLn(F, format('[%s]', [CNT_SECTION_GENERAL]));
    WriteLn(F, format('%s=%s', [CNT_GENERAL_NAME_COMBO, FLangComboName]));
    WriteLn(F, format('%s=%s', [CNT_GENERAL_GIDTOSTRFILE, FGidToStrFile]));
    WriteLn(F, '');



    WriteLn(F, format('[%s]', [CNT_SECTION_LOGIN]));
    WriteLn(F, format('%s=%s', [CNT_LOGIN_URL, FLoginURL]));
    WriteLn(F, format('%s=%s', [CNT_LOGIN_REFERENCE, FLoginReference]));
    WriteLn(F, '');
    WriteLn(F, '');


    WriteLn(F, format('[%s]', [CNT_SECTION_STRINGS]));

    
    for i := 0 to Count - 1 do begin
        pElement := Items[i];


        WriteLn(F, format('%s=%s', [pElement.Key, pElement.Valeur]));
    end;

    WriteLn(F, '');
    WriteLn(F, '');
    WriteLn(F, '# end of file');
    WriteLn(F, '');

    // Résultat
    Result := Count;
    
    // Ferme le fichier
    CloseFile(F);
    
end;

function TParsingLanguage.LoadFromFile(Fichier: string; bLoadHeaderOnly: boolean): integer;
type
    TSectionLecture = (sNeant, sGeneral, sLogin, sStrings);
    
var F: TextFile;
    Ligne, Key, Valeur: string;
    xPos: integer;
    Section : TSectionLecture;
begin



    if Fichier = '' then begin

       {$IFDEF DEBUGLANG}
            DoDebug('Parametre vide, utilisation du fichier interne');
       {$ENDIF}

       Fichier := FFichier;

    end;

    Result  := 0;
    Fichier := sfcUnixPathToDosPath(Fichier);
    FFichier := Fichier;
    Cleanup;

    if FileExists(Fichier) = false then begin
       {$IFDEF DEBUGLANG}
            DoDebug('Fichier inexistant');
       {$ENDIF}

       exit;
    end;

    FFIchier := Fichier;

    AssignFile(F, Fichier);

    FLangComboName := ExtractFileName(Fichier) + ' (nom oublié)';


       {$IFDEF DEBUGLANG}
            if NoT(bLoadHeaderOnly) then
               DoDebug('Chargement... ' + Fichier);
       {$ENDIF}


    {$I-}
    ReSet(F);
    {$I+}

    // IOResult renvoie 0 => cela signifie que la dernière opération d'E/S a réussi
    if NoT(IOResult = 0) then begin
       Result := -1;
       exit;
    end;


    Section := sNeant;

    While NoT(EoF(F)) do begin
         // Lit une ligne
         ReadLn(F, Ligne);

         Valeur := trimleft(Ligne);
         if length(Valeur) < 2 then Continue;

         if (Valeur[1] = '/') then Continue;
         if (Valeur[1] = '#') then Continue;
         if (Valeur[1] = ';') then Continue;




         xPos := pos('=', Ligne);
         if xPos = 0 then begin
            Ligne := trim(Ligne);
            if length(Ligne) < 3 then Continue;

            if Ligne[1] = '[' then begin
               System.Delete(Ligne, 1, 1);

               xPos := pos(']', Ligne);
               if xPos > 0 then begin
                  System.Delete(Ligne, xPos, maxint);

                  if SameText(Ligne, CNT_SECTION_GENERAL) then begin
                     Section := sGeneral;
                  end else if SameText(Ligne, CNT_SECTION_LOGIN) then begin
                     Section := sLogin;

                  end else if SameText(Ligne, CNT_SECTION_STRINGS) then begin
                     if NoT(bLoadHeaderOnly) then
                        Section := sStrings
                     else
                        Section := sNeant;


                  end else
                     Section := sNeant;
                     
               end;

            end;


         end else begin
             Key := copy(Ligne, 1, xPos - 1);
             Valeur := copy(Ligne, xPos + 1, maxint);

             case Section of
                  sGeneral: LoadSectionGeneral(Key, Valeur);
                  sLogin:  LoadSectionLogin(Key, Valeur);
                  sStrings: LoadSectionStrings(Key, Valeur);
             end;



         end;


         
    end;
    
    // Fermeture du fichier
    CloseFile(F);

    FLangComboName := trim(FLangComboName);
    if FLangComboName = '' then begin
       FLangComboName := ExtractFileName(Fichier) + ' (nom invalide)';
    end;


       {$IFDEF DEBUGLANG}
            if NoT(bLoadHeaderOnly) then
               DoDebug('Chargé... (' + IntToStr(count) + ' éléments)');
       {$ENDIF}

    Result := 1;

end;


function TParsingLanguage.GetData(Id: string; Default: string): string;
var pe: PLangValueKey;
begin
    pe := GetValeur(Id);

    if pe = nil then begin
       {$IFDEF DEBUGLANG}
           DoDebug('Non trouvé, utilisation défaut (Key: ' + Id + ')');
       {$ENDIF}
       Result := Default

    end else
       Result := pe.Valeur;

end;

function TParsingLanguage.GetDataChar(Id: string; Default: char): char;
var pe: PLangValueKey;
    s: string;
begin
    pe := GetValeur(Id);

    if pe = nil then begin
       {$IFDEF DEBUGLANG}
           DoDebug('Non trouvé, utilisation défaut (Key: ' + Id + ')');
       {$ENDIF}
       Result := Default

    end else begin
       s := pe.Valeur;
       if s <> '' then
          Result := s[1]
       else
          Result := Default;
    end;

end;


initialization
     LangParsing := TParsingLanguage.Create;


finalization
     LangParsing.Free;

end.
